home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / gapqbdr.zip / DOOR.ZIP / DOOR.BAS < prev    next >
BASIC Source File  |  1991-01-12  |  21KB  |  497 lines
  1. '****************************************************************************
  2. '*  Copyright (C) 1988-1991 The GAP Development Company
  3. '*
  4. '*  All Rights Reserved
  5. '*
  6. '*
  7. '*  DOOR.BAS
  8. '*
  9. '*  Demonstration program for GAPQBDR
  10. '*
  11. '*  To compile : bc /x door;
  12. '*  To link    : link door,,NUL.MAP,+gapqbdr
  13. '*
  14. '*  Program will need access to DOOR.CNF and DOOR.SYS
  15. '*
  16. '****************************************************************************
  17.  
  18.  
  19.    '***********************************************************************
  20.    '*  Before doing ANYTHING else, include the following file.            *
  21.    '***********************************************************************
  22.  
  23. ' $INCLUDE: 'GAPQBDR.BI'
  24.  
  25.  
  26.    '***********************************************************************
  27.    '*  Declare any subroutines prior to use                               *
  28.    '***********************************************************************
  29.  
  30.    DECLARE SUB main.menu ()               ' Our Main Menu handler
  31.    DECLARE SUB page.sysop ()              ' A page sysop routine
  32.    DECLARE SUB disp.file ()               ' display a text file
  33.    DECLARE SUB pos.curs ()                ' cursor positioning routines
  34.    DECLARE SUB do.input ()                ' input demo routines
  35.    DECLARE SUB do.output ()               ' output demo routines
  36.    DECLARE SUB era.mess (start%)          ' erase from start to end of screen
  37.    DECLARE SUB do.scores ()               ' displays the scoreboard
  38.  
  39.    '***********************************************************************
  40.    '*  Declare any global variables prior to use                          *
  41.    '***********************************************************************
  42.  
  43.    DIM SHARED anystring AS STRING         ' string used for most everything
  44.    DIM SHARED menu AS STRING              ' for building a menu
  45.    DIM SHARED prompt AS STRING            ' for the command prompt
  46.    DIM SHARED input.str (4,3) AS STRING   ' Output string
  47.    DIM SHARED output.str (4,3) AS STRING  ' Output string
  48.  
  49.    '***********************************************************************
  50.    '*  Must now read in the error handling code                           *
  51.    '***********************************************************************
  52.  
  53. ' $INCLUDE: 'GAPQBERR.BI'
  54.  
  55.    '***********************************************************************
  56.    '*  Begin main line code here                                          *
  57.    '***********************************************************************
  58.  
  59.    '***********************************************************************
  60.    '*  Before doing ANYTHING else, initialize the door with the following *
  61.    '*  two function calls.                                                *
  62.    '*  Then, if you have any configuration options, line input them in    *
  63.    '*  and close file # 1.                                                *
  64.    '***********************************************************************
  65.  
  66.    CALL read.cnf("DOOR.CNF")              ' read door configuration file
  67.    CALL init.door                         ' initialize the door
  68.  
  69.    CLOSE #1                               ' we dont have any configuration
  70.                       ' options so we will just close
  71.  
  72.  
  73.  
  74.    '***********************************************************************
  75.    '*  Lets now build some menus all at once.                             *
  76.    '*  These menus were created with an ANSI editor.  This is perhaps the *
  77.    '*  fastest and easiest way to create menus.  It is also faster to     *
  78.    '*  display a menu all at once instead of displaying each line of the  *
  79.    '*  menu one at a time.                                                *
  80.    '***********************************************************************
  81.  
  82.    IF c.olor = 1 THEN
  83.       menu = "C╔═══════════════════════════════════════════╗" + CRLF
  84.       menu = menu + "C║CMain MenuC║" + CRLF
  85.       menu = menu + "C╟───────────────────────────────────────────╢" + CRLF
  86.       menu = menu + "C║  [C]ursor PositioningC[P]age Sysop   ║" + CRLF
  87.       menu = menu + "C║  [I]nputC[S]how File    ║" + CRLF
  88.       menu = menu + "C║  [O]utputC[T]op Players  ║" + CRLF
  89.       menu = menu + "C║C[Q]uitC║" + CRLF
  90.       menu = menu + "C╚═══════════════════════════════════════════╝" + CRLF + CRLF
  91.    ELSE
  92.       menu =  "              ╔═══════════════════════════════════════════╗" + CRLF
  93.       menu = menu + "              ║                 Main Menu                 ║" + CRLF
  94.       menu = menu + "              ╟───────────────────────────────────────────╢" + CRLF
  95.       menu = menu + "              ║  [C]ursor Positioning      [P]age Sysop   ║" + CRLF
  96.       menu = menu + "              ║  [I]nput                   [S]how File    ║" + CRLF
  97.       menu = menu + "              ║  [O]utput                  [T]op Players  ║" + CRLF
  98.       menu = menu + "              ║                   [Q]uit                  ║" + CRLF
  99.       menu = menu + "              ╚═══════════════════════════════════════════╝" + CRLF + CRLF
  100.    END IF
  101.  
  102.    input.str[1,1] = "GET.STRING is the main input routine. It takes 1 parameter which" + CRLF
  103.    input.str[1,1] = input.str[1,1] + "is the string in which input is to be stored. The length of the" + CRLF
  104.    input.str[1,1] = input.str[1,1] + "string determines the number of characters allowed to be entered." + CRLF
  105.    input.str[1,1] = input.str[1,1] + "GET.STRING takes care of validating keystrokes and keyboard" + CRLF
  106.    input.str[1,1] = input.str[1,1] + "timeout." + CRLF
  107.  
  108.    input.str[1,2] = "  response$ = " + CHR$(34) + "    " + CHR$(34) + CRLF
  109.    input.str[1,2] = input.str[1,2] + "  CALL get.string(response$)" + CRLF
  110.  
  111.    input.str[1,3] = "  Will input a string with a maximum length of 4 characters."
  112.  
  113.    input.str[2,1] = "GETAKEY% is the main, single character input routine. It is called" + CRLF
  114.    input.str[2,1] = input.str[2,1] + "internally by GET.STRING and other GAPQBDR functions. It does not" + CRLF
  115.    input.str[2,1] = input.str[2,1] + "validate keystrokes nor does it check for keyboard timeout. GETAKEY%" + CRLF
  116.    input.str[2,1] = input.str[2,1] + "returns 0 if there are no characters waiting. Otherwise, it returns" + CRLF
  117.    input.str[2,1] = input.str[2,1] + "the ASCII code for the character." + CRLF
  118.  
  119.    input.str[2,2] = "  DIM r AS INTEGER" + CRLF
  120.    input.str[2,2] = input.str[2,2] + "  r = getakey%" + CRLF
  121.  
  122.    input.str[2,3] = "  If key waiting, will return the ASCII code for the character."
  123.  
  124.    input.str[3,1] = "CKEYPRESS% is used to determine if a character is waiting to be input." + CRLF
  125.    input.str[3,1] = input.str[3,1] + "It is used mainly in loops that must poll the keyboard and the comm" + CRLF
  126.    input.str[3,1] = input.str[3,1] + "port. It returns 0 if no key is waiting. Otherwise it returns the ASCII" + CRLF
  127.    input.str[3,1] = input.str[3,1] + "code for the character without removing the character from the keyboard" + CRLF
  128.    input.str[3,1] = input.str[3,1] + "buffer or the communications receive buffer." + CRLF
  129.  
  130.    input.str[3,2] = "  IF ckeypress% <> 0 THEN" + CRLF
  131.    input.str[3,2] = input.str[3,2] + "     ' execute if character is waiting" + CRLF
  132.  
  133.    input.str[3,3] = "  If characters waiting to be input, will execute body of THEN statement."
  134.  
  135.    input.str[4,1] = "GETKEYC% is used to retrieve keystrokes from the local keyboard. It isn't" + CRLF
  136.    input.str[4,1] = input.str[4,1] + "of much use to the GAPQBDR programmer since it checks ONLY the keyboard" + CRLF
  137.    input.str[4,1] = input.str[4,1] + "for characters and knows nothing about communications ports, keyboard" + CRLF
  138.    input.str[4,1] = input.str[4,1] + "timeout, or valid keystrokes. This routine WAITS for a keystroke. It" + CRLF
  139.    input.str[4,1] = input.str[4,1] + "returns the ASCII code and the keyboard scan code for the key pressed." + CRLF
  140.  
  141.    input.str[4,2] = "  DIM r AS INTEGER" + CRLF
  142.    input.str[4,2] = input.str[4,2] + "  r = getkeyc%" + CRLF
  143.  
  144.    input.str[4,3] = "  Calls the BIOS and waits for a keypress."
  145.  
  146.    output.str[1,1] = "SHOW.MESS is the main output routine. It takes 3 parameters:" + CRLF
  147.    output.str[1,1] = output.str[1,1] + "The string to output, a YES/NO flag to ring the bell, and a" + CRLF
  148.    output.str[1,1] = output.str[1,1] + "YES/NO flag to send a CR/LF after the string. The sysop's" + CRLF
  149.    output.str[1,1] = output.str[1,1] + "bell will ring only if the caller alarm is turned on. This" + CRLF
  150.    output.str[1,1] = output.str[1,1] + "text is being displayed with a single SHOW.MESS call." + CRLF
  151.  
  152.    output.str[1,2] = "  CALL show.mess(" + CHR$(34) + "This is an output string" + CHR$(34) + ",NO,YES)" + CRLF + CRLF
  153.  
  154.    output.str[1,3] = "  Will display the string on the local and remote consoles."
  155.  
  156.    output.str[2,1] = "PUTACHAR is the main single character output routine. It filters" + CRLF
  157.    output.str[2,1] = output.str[2,1] + "control characters and handles screen full situations. It should" + CRLF
  158.    output.str[2,1] = output.str[2,1] + "be used when single character output is desired since it" + CRLF
  159.    output.str[2,1] = output.str[2,1] + "automatically sends the characters to the communications port" + CRLF
  160.    output.str[2,1] = output.str[2,1] + "if a remote caller is online." + CRLF
  161.  
  162.    output.str[2,2] = "  CALL putachar('C')" + CRLF + CRLF
  163.  
  164.    output.str[2,3] = "  Will send the character 'C' to the local and remote consoles."
  165.  
  166.    output.str[3,1] = "SHOW.FILE is the routine that allows you to display text files." + CRLF
  167.    output.str[3,1] = output.str[3,1] + "It takes a single parameter, the full path and name of the" + CRLF
  168.    output.str[3,1] = output.str[3,1] + "file to display. Color files (those ending in 'G') are" + CRLF
  169.    output.str[3,1] = output.str[3,1] + "automatically displayed if the caller is in color mode and" + CRLF
  170.    output.str[3,1] = output.str[3,1] + "the file exists." + CRLF
  171.  
  172.    output.str[3,2] = "  CALL show.file(" + CHR$(34) + "C:\GAP\GEN\WELCOME" + CHR$(34) + ")" + CRLF + CRLF
  173.  
  174.    output.str[3,3] = "  Will show the Welcome file in the GAP\GEN directory."
  175.  
  176.    output.str[4,1] = "PUTKEY is an internal routine used by Sysop Chat. It provides" + CRLF
  177.    output.str[4,1] = output.str[4,1] + "for full word wrapping. It is an undocumented function" + CRLF
  178.    output.str[4,1] = output.str[4,1] + "but available for your use if you have a need for its" + CRLF
  179.    output.str[4,1] = output.str[4,1] + "word wrapping abilities." + CRLF + CRLF
  180.  
  181.    output.str[4,2] = "  CALL putkey('C')" + CRLF + CRLF
  182.  
  183.    output.str[4,3] = "  Will send the character 'C' and wrap the word if necessary."
  184.  
  185.    CALL main.menu                         ' main input routine
  186.  
  187.    CALL clear.scr                         ' clear the screen
  188.    CALL show.file("COMPARE")              ' show log off file
  189.    CALL pause                             ' wait for a keypress
  190.    CALL clear.scr                         ' tidy up the screen
  191.  
  192.    '***********************************************************************
  193.    ' The only proper way to exit the door is via the subroutine LEAVE.    *
  194.    ' Leave performs various functions that insure the computer is left in *
  195.    ' the state is was prior to running the door program. If leave is not  *
  196.    ' called prior to exiting the door, communications interrupts will     *
  197.    ' remain active and the computer will most surely hang as soon as      *
  198.    ' another program is loaded.                                           *
  199.    '***********************************************************************
  200.    
  201.    CALL leave                             ' thats all
  202.  
  203. END
  204.  
  205. SUB main.menu
  206.  
  207.    DIM response AS STRING            ' for getting responses
  208.  
  209.    CALL time.left
  210.  
  211.    DO
  212.  
  213.    '***********************************************************************
  214.    ' Lets now build our command prompt that will be used by other         *
  215.    ' routines. Notice that we will show the caller how much time he or    *
  216.    ' she has left. We can do this because GAP provides this information   *
  217.    ' to door programs. The amount of time (in minutes) a caller has left  *
  218.    ' is stored in the timeleft variable.                                  *
  219.    ' Our prompt will vary according to the color status of the caller.    *
  220.    '***********************************************************************
  221.  
  222.  
  223.       IF c.olor = 1 THEN
  224.          prompt = YELLOW + "[" + BRED + LTRIM$(STR$(timeleft)) + " mins" + YELLOW + "] Main Command : "
  225.       ELSE
  226.          prompt = "[" + LTRIM$(STR$(timeleft)) + " mins] Main Command : "
  227.       END IF
  228.  
  229.       CALL clear.scr                      ' first clear the screen
  230.  
  231.       CALL show.mess(menu, NO, YES)       ' show the menu
  232.       CALL show.mess(prompt, NO, NO)      ' show the prompt
  233.  
  234.       response = " "                      ' initialize response
  235.       CALL get.string(response)           ' get user input
  236.  
  237.       SELECT CASE response
  238.          CASE "C"
  239.             CALL pos.curs
  240.          CASE "I"
  241.             CALL do.input
  242.          CASE "O"
  243.             CALL do.output
  244.          CASE "P"
  245.             CALL page.sysop
  246.          CASE "S"
  247.             CALL disp.file
  248.          CASE "T"
  249.             CALL do.scores
  250.          CASE ELSE
  251.             IF response <> "Q" THEN
  252.                CALL nl(2)
  253.                CALL ansi(BRED)
  254.                CALL show.mess("Please Enter A Valid Response!", YES, YES)
  255.                CALL nl(1)
  256.                CALL pause
  257.             END IF
  258.       END SELECT
  259.  
  260.    LOOP UNTIL response = "Q"
  261.  
  262. END SUB
  263.  
  264. SUB page.sysop
  265.  
  266.    '***********************************************************************
  267.    '*  We are going to override the sysop's page bell flag so we can      *
  268.    '*  hear the bell.  This is not a good thing to do as it will tend     *
  269.    '*  to anger the sysop if a door program does not honor his BBS        *
  270.    '*  settings.  Sorry sysop.  We'll put the bell flag back the way it   *
  271.    '*  was when we are finished.                                          *
  272.    '***********************************************************************
  273.  
  274.    DIM oldbell AS INTEGER                 ' so we dont make sysop mad
  275.  
  276.    oldbell = bell                         ' keep track of old bell setting
  277.    bell = 1                               ' turn sysop's page bell on
  278.  
  279.    CALL pagesysop                         ' now page the sysop
  280.  
  281.    bell = oldbell                         ' restore old bell setting
  282.  
  283. END SUB
  284.  
  285.  
  286. SUB disp.file
  287.  
  288.    '***********************************************************************
  289.    '*  The show.file() routine makes certain assumptions about the file   *
  290.    '*  name being passed to it.  It assumes that you are calling it with  *
  291.    '*  a path and file name for a file that you know is or should be      *
  292.    '*  present.  Show.file() will attempt to find the file, but if it     *
  293.    '*  cannot, it simply returns (no error code).                         *
  294.    '***********************************************************************
  295.  
  296.    CALL clear.scr                         ' first clear the screen
  297.  
  298.    IF a.ccess%("WELCOME") <> 0 THEN       ' does file exist?
  299.       CALL nl(1)
  300.       CALL ansi(BRED)                     ' no, tell them in RED!
  301.       CALL show.mess("File 'WELCOME' Not Found!", YES, YES)
  302.       CALL nl(1)
  303.       CALL pause
  304.       EXIT SUB
  305.    END IF
  306.  
  307.    CALL ansi(YELLOW)                      ' reset default color
  308.  
  309.    CALL show.file("WELCOME")              ' now show the file.
  310.  
  311.    CALL pause                             ' wait for key press
  312.  
  313. END SUB
  314.  
  315. SUB pos.curs
  316.  
  317.    DIM r AS INTEGER
  318.    DIM r.ow AS INTEGER
  319.    DIM c.ol AS INTEGER
  320.  
  321.    CALL clear.scr                         ' first clear the screen
  322.  
  323.    CALL atsay(3,3,CHR$(201))              ' top left corner
  324.    
  325.    FOR r = 4 TO 77                        ' top edge
  326.      CALL atsay(3,r,CHR$(205))
  327.    NEXT r
  328.  
  329.    CALL atsay(3,78,CHR$(187))             ' top right corner
  330.  
  331.    FOR r = 4 TO 16                        ' right edge
  332.      CALL atsay(r,78,CHR$(186))
  333.    NEXT r
  334.  
  335.    CALL atsay(17,78,CHR$(188))            ' bottom right corner
  336.  
  337.    FOR r = 77 TO 4 STEP -1                ' bottom edge
  338.      CALL atsay(17,r,CHR$(205))
  339.    NEXT r
  340.  
  341.    CALL atsay(17,3,CHR$(200))              ' bottom left corner
  342.  
  343.    FOR r = 16 TO 4 STEP -1                 ' left edge
  344.      CALL atsay(r,3,CHR$(186))
  345.    NEXT r
  346.  
  347.    CALL ansi(BGREEN) 
  348.    CALL atsay(2,24,"Fast Screen Drawing Using ATSAY")
  349.    CALL atsay(18,39,"[8]")
  350.    CALL atsay(19,25,"Cursor    [4]     [6]    Movement")
  351.    CALL atsay(20,39,"[2]")
  352.    CALL atsay(22,18,"Move Cursor, Type A Character.  [Esc] To Quit.")
  353.  
  354.    r.ow = 10
  355.    c.ol = 40
  356.    CALL at(r.ow,c.ol)
  357.  
  358.    DO
  359.      temptime = get.time&                 ' get current time
  360.      DO
  361.         r = getakey%                      ' get a key press
  362.         IF r <> 0 THEN                    ' if there was a key press
  363.            EXIT DO                        ' then process key
  364.         END IF
  365.         CALL elap.time                    ' see if no keyboard activity
  366.      LOOP
  367.  
  368.      SELECT CASE r
  369.         CASE 27                           ' ESC pressed?
  370.            EXIT DO
  371.         CASE 50                           ' 2 - Down Arrow
  372.            r.ow = r.ow +1
  373.            if r.ow > 16 then r.ow = 4
  374.            CALL at(r.ow,c.ol)
  375.         CASE 52                           ' 4 - Left Arrow
  376.            c.ol = c.ol -1
  377.            if c.ol < 4 then c.ol = 77
  378.            CALL at(r.ow,c.ol)
  379.         CASE 54                           ' 6 - Right Arrow
  380.            c.ol = c.ol +1
  381.            if c.ol > 77 then c.ol = 4
  382.            CALL at(r.ow,c.ol)
  383.         CASE 56                           ' 8 - Up Arrow
  384.            r.ow = r.ow -1
  385.            if r.ow < 4 then r.ow = 16
  386.            CALL at(r.ow,c.ol)
  387.         CASE ELSE
  388.            IF r > 31 AND r < 127 THEN
  389.               CALL atsay(r.ow,c.ol,CHR$(r))    ' show the character
  390.               CALL at(r.ow,c.ol)               ' move cursor back
  391.            END IF
  392.      END SELECT
  393.  
  394.    LOOP UNTIL r = 27
  395.  
  396.    CALL at(22,1)
  397.    CALL eraeol
  398.    CALL pause
  399.  
  400. END SUB
  401.  
  402.  
  403. SUB do.input
  404.  
  405.    DIM r AS INTEGER
  406.    CALL clear.scr                         ' first clear the screen
  407.  
  408.    CALL ansi(BGREEN)
  409.    CALL show.mess("Input Routines",NO,YES)
  410.    CALL show.mess("==============",NO,YES)
  411.    CALL nl(1)
  412.    CALL ansi(YELLOW)
  413.    CALL show.mess("GET.STRING   - High Level",NO,YES)
  414.    CALL show.mess("GETAKEY%     - Low Level",NO,YES)
  415.    CALL show.mess("CKEYPRESS%   - Low Level",NO,YES)
  416.    CALL show.mess("GETKEYC%     - Low Level",NO,YES)
  417.    call nl(1)
  418.  
  419.    FOR r = 1 to 4   
  420.       CALL ansi(BCYAN)
  421.       CALL show.mess(input.str[r,1],NO,YES)
  422.       CALL ansi(BGREEN)
  423.       CALL show.mess("  Example",NO,YES)
  424.       CALL show.mess("  -------",NO,YES)
  425.       CALL nl(1)
  426.       CALL ansi(BCYAN)
  427.       CALL show.mess(input.str[r,2],NO,YES)
  428.       CALL ansi(BGREEN)
  429.       CALL show.mess(input.str[r,3],NO,YES)
  430.       CALL nl(1)
  431.       CALL pause
  432.       CALL era.mess(9)
  433.       CALL at(9,1)
  434.    NEXT r
  435.  
  436. END SUB
  437.  
  438. SUB do.output
  439.  
  440.    DIM r AS INTEGER
  441.    CALL clear.scr                         ' first clear the screen
  442.  
  443.    CALL ansi(BGREEN)
  444.    CALL show.mess("Output Routines",NO,YES)
  445.    CALL show.mess("===============",NO,YES)
  446.    CALL nl(1)
  447.    CALL ansi(YELLOW)
  448.    CALL show.mess("SHOW.MESS    - High Level",NO,YES)
  449.    CALL show.mess("PUTACHAR     - High Level",NO,YES)
  450.    CALL show.mess("SHOW.FILE    - High Level",NO,YES)
  451.    CALL show.mess("PUTKEY       - Low Level",NO,YES)
  452.    call nl(1)
  453.  
  454.    FOR r = 1 to 4   
  455.       CALL ansi(BCYAN)
  456.       CALL show.mess(output.str[r,1],NO,YES)
  457.       CALL ansi(BGREEN)
  458.       CALL show.mess("  Example",NO,YES)
  459.       CALL show.mess("  -------",NO,YES)
  460.       CALL nl(1)
  461.       CALL ansi(BCYAN)
  462.       CALL show.mess(output.str[r,2],NO,YES)
  463.       CALL ansi(BGREEN)
  464.       CALL show.mess(output.str[r,3],NO,YES)
  465.       CALL nl(1)
  466.       CALL pause
  467.       CALL era.mess(9)
  468.       CALL at(9,1)
  469.    NEXT r
  470.  
  471. END SUB
  472.  
  473. SUB era.mess (start%)
  474.  
  475.    ' Subroutine to erase from start position to end of screen
  476.    
  477.    DIM r AS INTEGER
  478.  
  479.    FOR r = start% to 23
  480.      CALL at(r,1)
  481.      CALL eraeol
  482.    NEXT r
  483.    
  484. END SUB
  485.  
  486. SUB do.scores
  487.  
  488.    IF read.score% ("DOOR.DAT","Example Door High Scores") = 1 THEN
  489.       CALL ansi(BRED)
  490.       CALL show.mess("File DOOR.DAT is Missing!",NO,YES)
  491.       CALL nl(1)
  492.       CALL pause
  493.    END IF
  494.  
  495. END SUB
  496.  
  497.